#!/usr/bin/perl

# =head1 NAME

# lilypond-gajaxapis-irc-bot - a bot that will support the Google AJAX APIs along with lilypond and Posterous

# =head1 DESCRIPTION

# This bot is just like cringer, except that it serves some particular functions for lilypond.  
# The objective is to build an IRC bot that will be able to run limited Javascript and serve as a resource for people searching
# for information on the Google AJAX APIs. This may ultimately include the ability to cross-reference the AJAX APIs Playground
# by Ben Lisbakken and co, documentation for the various APIs, etc. And since it can't be too stuffy, it should include some
# good ol' MSIE bashing.

# =cut


use strict;



print qq~\n\n ##############################################\n~;


my $cringer = cringer->new( # Bot initialization routine
 server => 'irc.freenode.net',
 channels => ['#lilypond','#wolfram'],
 nick => 'fringer',
 alt_nicks => ['fringer_','_fringer_','battle_fat','lilypond-gajaxapis-irc-bot'],
 name => 'fringer, the lilypond-gajaxapis-irc-bot.',
 dbHost => 'localhost',
 dbName => 'cringer',
 dbUser => 'cringer',
 dbPass => 'cringer',
 charset => "utf-8"
)->run;




# Define the bot here
package cringer;
use base qw(Bot::BasicBot);
use Chatbot::Eliza;
use DBI;
use LWP::UserAgent;
use JSON;
use URI::Escape;
use HTML::Parser ();
use Audio::Play::MPG123;


our @modules;


our $VERSION = '2.0';

use base 'Exporter';
our $EXPORT = qw~uriencode~;

our $debug = 1; # set to true to enter debug mode.

sub new{
 my $class = shift;
 my %args = @_;
 
 print qq~Initializing fringer v~.$cringer::VERSION.qq~...\n~; 
 my $self = bless Bot::BasicBot->new( %args ); # initialize the underlying bot
 print qq~Bot initialized.\n~;

 print qq~Loading modules...\n~;
 my $lP;
 my $modCount = 0;
 BEGIN{
  $lP = qq~fringer~;
 }
 use lib $lP;
 if(opendir(LIB, $lP)){
  foreach my $l (readdir(LIB)){
   unless ($l !~ /^(.*)\.pm$/){
    print "$l: ";
    eval qq~require fringer::~ . $1 . qq~;~;
    if($@ ne ''){
     print "Unable to load module $1: $@\n";
     next;
    } else {
     print qq~$1 loaded.\n~;
    }
    push(@modules,$1);
    $modCount++;
   }
  }
 }
 @modules = sort {
   if($a eq 'translate'){
    return 1;
   } elsif($b eq 'translate'){
    return -1;
   }
   return 0;
  } @modules;
  
 print join(', ',@modules). "\n";
 print qq~$modCount modules loaded.\n~;

 print qq~Starting Eliza engine...\n~;
 $self->{eliza} = new Chatbot::Eliza; # initialize the eliza response engine
 print qq~Eliza started.\n~;

 print qq~Connecting to database...\n~;
 my ($dbHost,$dbType,$dbName,$dbUser,$dbPass,$d);
 $dbHost = $args{'dbHost'};
 $dbType = gtg($args{'dbType'}) ? $args{'dbType'} : 'mysql';
 $dbName = $args{'dbName'};
 $dbUser = $args{'dbUser'};
 $dbPass = $args{'dbPass'};
 if(gtg($dbHost,$dbType,$dbName,$dbUser,$dbPass)){ # if all database vars are defined, let's connect
  eval { $d = DBI->connect(qq~DBI:$dbType:$dbName:$dbHost~, $dbUser, $dbPass, {PrintError => 0, RaiseError => 0} ); };
  if($@ ne ''){
   warn $@;
   $d = undef;
  }
 }
 $self->{d} = $d;
 print qq~Database connection ~ . ((defined($d)) ? 'successful' : 'failed') . qq~.\n~;
 
 print qq~Initializing UserAgent...\n~;
 $self->{ua} = LWP::UserAgent->new(); # initialize the UserAgent object
 $self->{ua}->default_header('HTTP_REFERER' => 'http://code.google.com/p/gajaxapis-irc-bot');
 print qq~UserAgent initialized.\n~;

 print qq~Initializing Voice... \n~;
 $self->{player} = Audio::Play::MPG123->new();
 print qq~Voice Initialized.\n~;

 return $self;
}

sub connected{
 my $self = shift;
 my $args = shift;
 my $me = $self->{nick};

 print qq~Connected as $self->{nick}\n~;
}

sub chanjoin{
 my $self = shift; 
 my $args = shift;
 if ($args->{channel} eq "#lilypond"){
  $self->{d}->do("INSERT INTO lilypond ( nick ) VALUES ( '$args->{who}' ) ON DUPLICATE KEY UPDATE new=0");
  if ($self->{d}->selectrow_array("SELECT new FROM lilypond WHERE nick = '$args->{who}'")){
   $self->say(
     channel => $args->{channel}, 
     who => $args->{who}, 
     body => $args->{who} . ": Welcome to #lilypond, if no-one answers right away, hang around for a while.  It could take up to half a day for someone to answer.  ");
  }
 } 
} 

sub said{
 my $self = shift;
 my $args = shift;
 my $me = $self->{nick};
 
 my @r = undef;
 foreach my $m (@modules){ # loop through the modules to see if we get a hit
  eval qq~\@r = cringer::~ . $m . qq~::said(\$self, \$args);~;
  if($@ ne ''){
   print qq~Error calling $m: $@\n~;
  }
  if((defined(@r)) && (@r > 0)){ # if the module answers, it should return an array of things for us to say
   foreach my $r (@r){
    $self->say(
     channel => $args->{channel},
     who => $args->{who},
     body => $r
    );
   }
   return;
  }
 }
 if($args->{address}){ # if none of the modules have answered AND I've been directly addressed, let's figure out what to do with it
  if($args->{body} =~ /^(introduce yourself|about|hello)$/i){
   return qq~Hello, my name is fringer, the lilypond-gajaxapis-irc-bot. http://code.google.com/p/gajaxapis-irc-bot~;
  } else {
   return $self->{eliza}->transform($args->{body});
  }
 }


# return undef; # I guess they weren't talking to me.
}

sub help{ # set up a help handler
 my $self = shift;
 my $args = shift;
 my $me = $self->{nick};
 
 if($debug){
  print qq~Processing help request...\n~;
 }

 my(@cols,$q,@w,@o,@vals);
 @cols = qw~entry~; # initial list of columns to get
 
 $args->{body} =~ /^help[\W]*(.*?)\W*$/; # check for a search query
 $q = $1;
 if(gtg($q)){
  my $c = qq~MATCH (entry) AGAINST (? IN BOOLEAN MODE)~;
  push(@w, $c);
  push(@o, qq~$c DESC~);
  push(@vals, $q, $q);

  # build the sql query and search for help
  my $sql = qq~SELECT ~ . join(',',@cols) . qq~ FROM help~ . (@w > 0 ? qq~ WHERE (~ . join(') AND (', @w) . qq~)~ : '') . (@o > 0 ? qq~ ORDER BY ~ . join(',', @o) : '') . qq~;~;
  my $query = $self->{d}->prepare($sql);
  $query->execute(@vals) ||
   warn $query->errstr;
  my $c = 0;
  while (my $row = $query->fetchrow_hashref()){
   $self->say(
    channel => $args->{channel},
    who => $args->{who},
    body => $row->{entry}
   );
   $c++;
  }
  if(!$c){
   return qq~Sorry; I can't help you with that query.~;
  }
  return;
 }
 my @commands;
 foreach my $m (@modules){
  my $cmds;
  my $syntax = qq~\$cmds = &cringer::~ . $m . qq~::commandList();~;
  eval $syntax;
  print qq~$m: $cmds\n~;
  if(defined($cmds)){
   push(@commands, $cmds);
  }
 }
 return qq~Command list: ~ . join(' | ', @commands);
}

sub gtg{ # check if a given value is (a) defined and (b) not an empty string
 my $v = shift;
 return ((defined($v)) && ($v=~/\S/)) ? 1 : 0;
}

sub uriencode{ # 
 return uri_escape_utf8(shift);
}

return 1;
